home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol146 / xlfio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-12-16  |  7.0 KB  |  328 lines
  1. /* xlfio.c - xlisp file i/o */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern NODE *s_stdin,*s_stdout;
  10. extern NODE *xlstack;
  11. extern int xlfsize;
  12. extern char buf[];
  13.  
  14. /* external routines */
  15. extern FILE *fopen();
  16.  
  17. /* forward declarations */
  18. FORWARD NODE *printit();
  19. FORWARD NODE *flatsize();
  20. FORWARD NODE *openit();
  21.  
  22. /* xread - read an expression */
  23. NODE *xread(args)
  24.   NODE *args;
  25. {
  26.     NODE *oldstk,fptr,eof,*val;
  27.  
  28.     /* create a new stack frame */
  29.     oldstk = xlsave(&fptr,&eof,NULL);
  30.  
  31.     /* get file pointer and eof value */
  32.     fptr.n_ptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
  33.     eof.n_ptr = (args ? xlarg(&args) : NIL);
  34.     xllastarg(args);
  35.  
  36.     /* read an expression */
  37.     if (!xlread(fptr.n_ptr,&val))
  38.     val = eof.n_ptr;
  39.  
  40.     /* restore the previous stack frame */
  41.     xlstack = oldstk;
  42.  
  43.     /* return the expression */
  44.     return (val);
  45. }
  46.  
  47. /* xprint - builtin function 'print' */
  48. NODE *xprint(args)
  49.   NODE *args;
  50. {
  51.     return (printit(args,TRUE,TRUE));
  52. }
  53.  
  54. /* xprin1 - builtin function 'prin1' */
  55. NODE *xprin1(args)
  56.   NODE *args;
  57. {
  58.     return (printit(args,TRUE,FALSE));
  59. }
  60.  
  61. /* xprinc - builtin function princ */
  62. NODE *xprinc(args)
  63.   NODE *args;
  64. {
  65.     return (printit(args,FALSE,FALSE));
  66. }
  67.  
  68. /* xterpri - terminate the current print line */
  69. NODE *xterpri(args)
  70.   NODE *args;
  71. {
  72.     NODE *fptr;
  73.  
  74.     /* get file pointer */
  75.     fptr = (args ? xlgetfile(&args) : getvalue(s_stdout));
  76.     xllastarg(args);
  77.  
  78.     /* terminate the print line and return nil */
  79.     xlterpri(fptr);
  80.     return (NIL);
  81. }
  82.  
  83. /* printit - common print function */
  84. LOCAL NODE *printit(args,pflag,tflag)
  85.   NODE *args; int pflag,tflag;
  86. {
  87.     NODE *oldstk,fptr,val;
  88.  
  89.     /* create a new stack frame */
  90.     oldstk = xlsave(&fptr,&val,NULL);
  91.  
  92.     /* get expression to print and file pointer */
  93.     val.n_ptr = xlarg(&args);
  94.     fptr.n_ptr = (args ? xlgetfile(&args) : getvalue(s_stdout));
  95.     xllastarg(args);
  96.  
  97.     /* print the value */
  98.     xlprint(fptr.n_ptr,val.n_ptr,pflag);
  99.  
  100.     /* terminate the print line if necessary */
  101.     if (tflag)
  102.     xlterpri(fptr.n_ptr);
  103.  
  104.     /* restore the previous stack frame */
  105.     xlstack = oldstk;
  106.  
  107.     /* return the result */
  108.     return (val.n_ptr);
  109. }
  110.  
  111. /* xflatsize - compute the size of a printed representation using prin1 */
  112. NODE *xflatsize(args)
  113.   NODE *args;
  114. {
  115.     return (flatsize(args,TRUE));
  116. }
  117.  
  118. /* xflatc - compute the size of a printed representation using princ */
  119. NODE *xflatc(args)
  120.   NODE *args;
  121. {
  122.     return (flatsize(args,FALSE));
  123. }
  124.  
  125. /* flatsize - compute the size of a printed expression */
  126. LOCAL NODE *flatsize(args,pflag)
  127.   NODE *args; int pflag;
  128. {
  129.     NODE *oldstk,val;
  130.  
  131.     /* create a new stack frame */
  132.     oldstk = xlsave(&val,NULL);
  133.  
  134.     /* get the expression */
  135.     val.n_ptr = xlarg(&args);
  136.     xllastarg(args);
  137.  
  138.     /* print the value to compute its size */
  139.     xlfsize = 0;
  140.     xlprint(NIL,val.n_ptr,pflag);
  141.  
  142.     /* restore the previous stack frame */
  143.     xlstack = oldstk;
  144.  
  145.     /* return the length of the expression */
  146.     return (cvfixnum((FIXNUM)xlfsize));
  147. }
  148.  
  149. /* xopeni - open an input file */
  150. NODE *xopeni(args)
  151.   NODE *args;
  152. {
  153.     return (openit(args,"r"));
  154. }
  155.  
  156. /* xopeno - open an output file */
  157. NODE *xopeno(args)
  158.   NODE *args;
  159. {
  160.     return (openit(args,"w"));
  161. }
  162.  
  163. /* openit - common file open routine */
  164. LOCAL NODE *openit(args,mode)
  165.   NODE *args; char *mode;
  166. {
  167.     NODE *fname,*val;
  168.     FILE *fp;
  169.  
  170.     /* get the file name */
  171.     fname = xlmatch(STR,&args);
  172.     xllastarg(args);
  173.  
  174.     /* try to open the file */
  175.     if ((fp = fopen(fname->n_str,mode)) != NULL) {
  176.     val = newnode(FPTR);
  177.     val->n_fp = fp;
  178.     val->n_savech = 0;
  179.     }
  180.     else
  181.     val = NIL;
  182.  
  183.     /* return the file pointer */
  184.     return (val);
  185. }
  186.  
  187. /* xclose - close a file */
  188. NODE *xclose(args)
  189.   NODE *args;
  190. {
  191.     NODE *fptr;
  192.  
  193.     /* get file pointer */
  194.     fptr = xlmatch(FPTR,&args);
  195.     xllastarg(args);
  196.  
  197.     /* make sure the file exists */
  198.     if (fptr->n_fp == NULL)
  199.     xlfail("file not open");
  200.  
  201.     /* close the file */
  202.     fclose(fptr->n_fp);
  203.     fptr->n_fp = NULL;
  204.  
  205.     /* return nil */
  206.     return (NIL);
  207. }
  208.  
  209. /* xrdchar - read a character from a file */
  210. NODE *xrdchar(args)
  211.   NODE *args;
  212. {
  213.     NODE *fptr;
  214.     int ch;
  215.  
  216.     /* get file pointer */
  217.     fptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
  218.     xllastarg(args);
  219.  
  220.     /* get character and check for eof */
  221.     return ((ch = xlgetc(fptr)) == EOF ? NIL : cvfixnum((FIXNUM)ch));
  222. }
  223.  
  224. /* xpkchar - peek at a character from a file */
  225. NODE *xpkchar(args)
  226.   NODE *args;
  227. {
  228.     NODE *flag,*fptr;
  229.     int ch;
  230.  
  231.     /* peek flag and get file pointer */
  232.     flag = (args ? xlarg(&args) : NIL);
  233.     fptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
  234.     xllastarg(args);
  235.  
  236.     /* skip leading white space and get a character */
  237.     if (flag)
  238.     while ((ch = xlpeek(fptr)) != EOF && isspace(ch))
  239.         xlgetc(fptr);
  240.     else
  241.     ch = xlpeek(fptr);
  242.  
  243.     /* return the character */
  244.     return (ch == EOF ? NIL : cvfixnum((FIXNUM)ch));
  245. }
  246.  
  247. /* xwrchar - write a character to a file */
  248. NODE *xwrchar(args)
  249.   NODE *args;
  250. {
  251.     NODE *fptr,*chr;
  252.  
  253.     /* get the character and file pointer */
  254.     chr = xlmatch(INT,&args);
  255.     fptr = (args ? xlgetfile(&args) : getvalue(s_stdout));
  256.     xllastarg(args);
  257.  
  258.     /* put character to the file */
  259.     xlputc(fptr,(int)chr->n_int);
  260.  
  261.     /* return the character */
  262.     return (chr);
  263. }
  264.  
  265. /* xreadline - read a line from a file */
  266. NODE *xreadline(args)
  267.   NODE *args;
  268. {
  269.     NODE *oldstk,fptr,str;
  270.     char *p,*sptr;
  271.     int len,ch;
  272.  
  273.     /* create a new stack frame */
  274.     oldstk = xlsave(&fptr,&str,NULL);
  275.  
  276.     /* get file pointer */
  277.     fptr.n_ptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
  278.     xllastarg(args);
  279.  
  280.     /* make a string node */
  281.     str.n_ptr = newnode(STR);
  282.     str.n_ptr->n_strtype = DYNAMIC;
  283.  
  284.     /* get character and check for eof */
  285.     len = 0; p = buf;
  286.     while ((ch = xlgetc(fptr.n_ptr)) != EOF && ch != '\n') {
  287.  
  288.     /* check for buffer overflow */
  289.     if ((int)(p - buf) == STRMAX) {
  290.         *p = 0;
  291.          sptr = stralloc(len + STRMAX); *sptr = 0;
  292.         if (len) {
  293.         strcpy(sptr,str.n_ptr->n_str);
  294.         strfree(str.n_ptr->n_str);
  295.         }
  296.         str.n_ptr->n_str = sptr;
  297.         strcat(sptr,buf);
  298.         len += STRMAX;
  299.         p = buf;
  300.     }
  301.  
  302.     /* store the character */
  303.     *p++ = ch;
  304.     }
  305.  
  306.     /* check for end of file */
  307.     if (len == 0 && p == buf && ch == EOF) {
  308.     xlstack = oldstk;
  309.     return (NIL);
  310.     }
  311.  
  312.     /* append the last substring */
  313.     *p = 0;
  314.     sptr = stralloc(len + (int)(p - buf)); *sptr = 0;
  315.     if (len) {
  316.     strcpy(sptr,str.n_ptr->n_str);
  317.     strfree(str.n_ptr->n_str);
  318.     }
  319.     str.n_ptr->n_str = sptr;
  320.     strcat(sptr,buf);
  321.  
  322.     /* restore the previous stack frame */
  323.     xlstack = oldstk;
  324.  
  325.     /* return the string */
  326.     return (str.n_ptr);
  327. }
  328.